home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-1.ZIP;1 / COMMON.ZIP / RTDB.C < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-10  |  41.1 KB  |  1,501 lines
  1. /*
  2.  * Routines to read a data base of run-time information.
  3.  */
  4. #include <ctype.h>
  5. #include "../h/gsupport.h"
  6. #include "../h/version.h"
  7.  
  8. #define GetInt(n, c)\
  9.    n = 0;\
  10.    while (isdigit(c)) {\
  11.       n = n * 10 + (c - '0');\
  12.       c = getc(db);\
  13.       }
  14.  
  15. #define SkipWhSp(c)\
  16.    while (isspace(c)) {\
  17.       if (c == '\n')\
  18.          ++dbline;\
  19.       c = getc(db);\
  20.       }
  21.  
  22. /*
  23.  * prototypes for static functions.
  24.  */
  25. hidden int            cmp_1_pre  Params((int p1, int p2));
  26. hidden struct il_code *db_abstr  Params((noargs));
  27. hidden novalue         db_case   Params((struct il_code *il, int num_cases));
  28. hidden novalue         db_err3   Params((int fatal,char *s1,char *s2,char *s3));
  29. hidden int             db_icntyp Params((noargs));
  30. hidden struct il_c    *db_ilc    Params((noargs));
  31. hidden struct il_c    *db_ilcret Params((int il_c_type));
  32. hidden struct il_code *db_inlin  Params((noargs));
  33. hidden struct il_code *db_ilvar  Params((noargs));
  34. hidden int             db_rtflg  Params((noargs));
  35. hidden int             db_tndtyp Params((noargs));
  36. hidden struct il_c    *new_ilc   Params((int il_c_type));
  37. hidden novalue          quoted   Params((int delim));
  38.  
  39. extern char *progname;
  40.  
  41. static char *dbname;
  42. static FILE *db;
  43. static int dbline;
  44. static struct str_buf db_sbuf;
  45.  
  46. /*
  47.  * opendb - open data base and do other house keeping.
  48.  */
  49. int db_open(s, lrgintflg)
  50. char *s;
  51. char **lrgintflg;
  52.    {
  53.    char *msg_buf;
  54.    static int first_time = 1;
  55.  
  56.    if (first_time) {
  57.       first_time = 0;
  58.       init_sbuf(&db_sbuf);
  59.       }
  60.    dbname = s;  
  61.    dbline = 0;
  62.    *lrgintflg = NULL;
  63.    db = fopen(dbname, "r");
  64.    if (db == NULL)
  65.       return 0;
  66.    ++dbline;
  67.    s = db_string();
  68.    if (strcmp(s, DVersion) != 0) {
  69.       msg_buf = (char *)alloc((unsigned int) 35 + (int)(strlen(s) +
  70.          strlen(progname) + strlen(DVersion)));
  71.       sprintf(msg_buf, "found version %s, %s requires version %s",
  72.            s, progname, DVersion);
  73.       db_err1(1, msg_buf);
  74.       }
  75.    *lrgintflg = db_string();
  76.    return 1;
  77.    }
  78.  
  79. novalue db_close()
  80.    {
  81.    fclose(db);
  82.    }
  83.  
  84. char *db_string()
  85.    {
  86.    register int c;
  87.  
  88.    /*
  89.     * Look for the start of the string; '$' starts a special indicator.
  90.     *  Copy characters into string buffer until white space is found.
  91.     */
  92.    c = getc(db);
  93.    SkipWhSp(c);
  94.    if (c == EOF)
  95.       db_err1(1, "unexpeced EOF");
  96.    if (c == '$')
  97.       return NULL;
  98.    while (!isspace(c) && c != EOF) {
  99.       AppChar(db_sbuf, c);
  100.       c = getc(db);
  101.       }
  102.    if (c == '\n')
  103.       ++dbline;
  104.    return str_install(&db_sbuf);
  105.    }
  106.  
  107. /*
  108.  * db_impl reads basic implementation information into a structure and
  109.  *  returns it.
  110.  */
  111. struct implement *db_impl(oper_typ)
  112. int oper_typ;
  113.    {
  114.    register struct implement *ip;
  115.    register int c;
  116.    int i;
  117.    char *name;
  118.    long n;
  119.  
  120.    if ((name = db_string()) == NULL)
  121.       return NULL;
  122.  
  123.    ip = NewStruct(implement);
  124.    ip->blink = NULL;
  125.    ip->iconc_flgs = 0;         /* reserved for internal use by compiler */
  126.    ip->oper_typ = oper_typ;
  127.    ip->name = name;
  128.    ip->op = NULL;
  129.  
  130.    c = getc(db);
  131.    SkipWhSp(c)
  132.    if (isalpha(c) || isdigit(c))
  133.       ip->prefix[0] = c;
  134.    else
  135.      db_err2(1, "invalid prefix for", ip->name);
  136.    c = getc(db);
  137.    if (isalpha(c) || isdigit(c))
  138.       ip->prefix[1] = c;
  139.    else
  140.      db_err2(1, "invalid prefix for", ip->name);
  141.    c = getc(db);
  142.    SkipWhSp(c)
  143.    if (!isdigit(c))
  144.      db_err2(1, "number of parameters missing for", ip->name);
  145.    GetInt(n, c)
  146.    ip->nargs = n;
  147.    if (n == 0)
  148.       ip->arg_flgs = NULL;
  149.    else
  150.       ip->arg_flgs = (int *)alloc((unsigned int) (sizeof(int) * n));
  151.    if (c != '(')
  152.       db_err2(1, "parameter flags missing for", ip->name);
  153.    c = getc(db);
  154.    for (i = 0; i < n; ++i) {
  155.       if (c == ',' || c == ')')
  156.          db_err2(1, "parameter flag missing for", ip->name);
  157.       ip->arg_flgs[i] = 0;
  158.       while (c != ',' && c != ')') {
  159.           switch (c) {
  160.              case 'u':
  161.                 ip->arg_flgs[i] |= RtParm;
  162.                 break;
  163.              case 'd':
  164.                 ip->arg_flgs[i] |= DrfPrm;
  165.                 break;
  166.              case 'v':
  167.                 ip->arg_flgs[i] |= VarPrm;
  168.                 break;
  169.              default:
  170.                 db_err2(1, "invalid parameter flag for", ip->name);
  171.              }
  172.          c = getc(db);
  173.          }
  174.       if (c == ',')
  175.          c = getc(db);
  176.       }
  177.    if (c != ')')
  178.      db_err2(1, "invalid parameter flag list for", ip->name);
  179.    c = getc(db);
  180.    SkipWhSp(c)
  181.    if (c != '{')
  182.      db_err2(1, "result sequence missing for", ip->name);
  183.    c = getc(db);
  184.    ip->resume = 0;
  185.    if (c == '}') {
  186.       ip->min_result = NoRsltSeq;
  187.       ip->max_result = NoRsltSeq;
  188.       }
  189.    else {
  190.       if (!isdigit(c))
  191.         db_err2(1, "invalid result sequence for", ip->name);
  192.       GetInt(n, c)
  193.       ip->min_result = n;
  194.       if (c != ',')
  195.         db_err2(1, "invalid result sequence for", ip->name);
  196.       c = getc(db);
  197.       if (c == '*') {
  198.          ip->max_result = UnbndSeq;
  199.          c = getc(db);
  200.          }
  201.       else if (isdigit(c)) {
  202.          GetInt(n, c)
  203.          ip->max_result = n;
  204.          }
  205.       else
  206.         db_err2(1, "invalid result sequence for", ip->name);
  207.       if (c == '+') {
  208.          ip->resume = 1;
  209.          c = getc(db);
  210.          }
  211.       if (c != '}')
  212.         db_err2(1, "invalid result sequence for", ip->name);
  213.       }
  214.    ip->ret_flag = db_rtflg();
  215.    c = getc(db);
  216.    SkipWhSp(c)
  217.    switch (c) {
  218.       case 't':
  219.          ip->use_rslt = 1;
  220.          break;
  221.       case 'f':
  222.          ip->use_rslt = 0;
  223.          break;
  224.       default:
  225.          db_err2(1, "invalid 'result' use indicator for", ip->name);
  226.          }
  227.    return ip;
  228.    }
  229.  
  230. /*
  231.  * db_code - read the in-line code for an operation.
  232.  */
  233. novalue db_code(ip)
  234. struct implement *ip;
  235.    {
  236.    register int c;
  237.    char *s;
  238.    word n;
  239.    int var_type;
  240.    int i;
  241.  
  242.    /*
  243.     * read the descriptive string.
  244.     */
  245.    c = getc(db);
  246.    SkipWhSp(c)
  247.    if (c != '"')
  248.       db_err1(1, "operation description expected");
  249.    for (c = getc(db); c != '"' && c != '\n' && c != EOF; c = getc(db)) {
  250.       if (c == '\\') {
  251.          AppChar(db_sbuf, c);
  252.          c = getc(db);
  253.          }
  254.       AppChar(db_sbuf, c);
  255.       }
  256.    if (c != '"')
  257.       db_err1(1, "expected '\"'");
  258.    ip->comment = str_install(&db_sbuf);
  259.    c = getc(db);
  260.    SkipWhSp(c)
  261.    GetInt(n, c)
  262.    ip->ntnds = n;
  263.    if (n == 0)
  264.       ip->tnds = NULL;
  265.    else
  266.       ip->tnds = (struct tend_var *)alloc((unsigned int)
  267.          (sizeof(struct tend_var) * n));
  268.    for (i = 0; i < n; ++i) {
  269.       var_type = db_tndtyp();
  270.       ip->tnds[i].var_type = var_type;
  271.       ip->tnds[i].blk_name = NULL;
  272.       if (var_type == TndBlk) {
  273.          s = db_string();
  274.          if (s == NULL)
  275.             db_err1(1, "block name expected");
  276.          if (*s != '*')
  277.             ip->tnds[i].blk_name = s;
  278.          }
  279.       ip->tnds[i].init = db_ilc();
  280.       }
  281.    c = getc(db);
  282.    SkipWhSp(c)
  283.    GetInt(n, c)
  284.    ip->nvars = n;
  285.    if (n == 0)
  286.       ip->vars = NULL;
  287.    else
  288.       ip->vars = (struct ord_var *)alloc((unsigned int)
  289.          (sizeof(struct ord_var) * n));
  290.    for (i = 0; i < n; ++i) {
  291.       s = db_string();
  292.       if (s == NULL)
  293.          db_err1(1, "variable name expected");
  294.       ip->vars[i].name = s;
  295.       ip->vars[i].dcl = db_ilc();
  296.       }
  297.    ip->in_line = db_inlin();
  298.    c = getc(db);
  299.    SkipWhSp(c)
  300.    if (c != '$')
  301.       db_err1(1, "expected $end");
  302.    }
  303.  
  304. /*
  305.  * db_inlin - read in the in-line code for an operation.
  306.  */
  307. static struct il_code *db_inlin()
  308.    {
  309.    struct il_code *il;
  310.    register int c;
  311.    int i;
  312.    int indx;
  313.    int n, n1;
  314.  
  315.    c = getc(db);
  316.    SkipWhSp(c)
  317.    switch (c) {
  318.       case 'a':
  319.          db_chstr("a", "bstr");
  320.          il = new_il(IL_Abstr, 2);
  321.          il->u[0].fld = db_abstr();
  322.          il->u[1].fld = db_abstr();
  323.          break;
  324.  
  325.       case 'b':
  326.          db_chstr("b", "lock");
  327.          c = getc(db);
  328.          SkipWhSp(c)
  329.          GetInt(n, c)                      /* number of local tended */
  330.          il = new_il(IL_Block, 2 + n);
  331.          il->u[0].n = n;
  332.          for (i = 1; i <= n; ++i)
  333.              il->u[i].n = db_tndtyp();
  334.          il->u[i].c_cd = db_ilc();         /* body of block */
  335.          break;
  336.  
  337.       case 'c':
  338.          switch (getc(db)) {
  339.             case 'a': {
  340.                char prfx3;
  341.                int ret_val;
  342.                int ret_flag;
  343.                int rslt;
  344.                int num_sbuf;
  345.                int num_cbuf;
  346.  
  347.                db_chstr("ca", "ll");
  348.                c = getc(db);
  349.                SkipWhSp(c)
  350.                prfx3 = c;
  351.                c = getc(db);
  352.                SkipWhSp(c)
  353.                switch (c) {
  354.                   case 'i':
  355.                      ret_val = RetInt;
  356.                      break;
  357.                   case 'd':
  358.                      ret_val = RetDbl;
  359.                      break;
  360.                   case 'n':
  361.                      ret_val = RetNoVal;
  362.                      break;
  363.                   case 's':
  364.                      ret_val = RetSig;
  365.                      break;
  366.                   default:
  367.                      db_err1(1, "invalid indicator for type of return value");
  368.                   }
  369.                c = getc(db);
  370.                ret_flag = db_rtflg();
  371.                c = getc(db);
  372.                SkipWhSp(c)
  373.                switch (c) {
  374.                   case 't':
  375.                      rslt = 1;
  376.                      break;
  377.                   case 'f':
  378.                      rslt = 0;
  379.                      break;
  380.                   default:
  381.                      db_err1(1, "t or f expected");
  382.                   }
  383.                c = getc(db);
  384.                SkipWhSp(c)
  385.                GetInt(num_sbuf, c)
  386.                c = getc(db);
  387.                SkipWhSp(c)
  388.                GetInt(num_cbuf, c)
  389.                c = getc(db);
  390.                SkipWhSp(c)
  391.                GetInt(n, c)       /* num args */
  392.                il = new_il(IL_Call, 8 + n * 2);
  393.                il->u[0].n = 0;      /* reserved for internal use by compiler */
  394.                il->u[1].n = prfx3;
  395.                il->u[2].n = ret_val;
  396.                il->u[3].n = ret_flag;
  397.                il->u[4].n = rslt;
  398.                il->u[5].n = num_sbuf;
  399.                il->u[6].n = num_cbuf;
  400.                il->u[7].n = n;
  401.                indx = 8;
  402.                /*
  403.                 * get the prototype parameter declarations and actual arguments.
  404.                 */
  405.                n *= 2;
  406.                while (n--)
  407.                   il->u[indx++].c_cd = db_ilc();
  408.                }
  409.                break;
  410.  
  411.             case 'n':
  412.                if (getc(db) != 'v')
  413.                   db_err1(1, "expected cnv1 or cnv2");
  414.                switch (getc(db)) {
  415.                   case '1':
  416.                      il = new_il(IL_Cnv1, 2);
  417.                      il->u[0].n = db_icntyp();      /* type code */
  418.                      il->u[1].fld = db_ilvar();     /* source */
  419.                      break;
  420.                   case '2':
  421.                      il = new_il(IL_Cnv2, 3);
  422.                      il->u[0].n = db_icntyp();      /* type code */
  423.                      il->u[1].fld = db_ilvar();     /* source */
  424.                      il->u[2].c_cd = db_ilc();      /* destination */
  425.                      break;
  426.                   default:
  427.                      db_err1(1, "expected cnv1 or cnv2");
  428.                   }
  429.                break;
  430.  
  431.             case 'o':
  432.                db_chstr("co", "nst");
  433.                il = new_il(IL_Const, 2);
  434.                il->u[0].n = db_icntyp();      /* type code */
  435.                c = getc(db);
  436.                SkipWhSp(c)
  437.                if (c == '"' || c == '\'') {
  438.                   quoted(c);
  439.                   c = getc(db);
  440.                   }
  441.                else
  442.                   while (c != EOF && !isspace(c)) {
  443.                      AppChar(db_sbuf, c);
  444.                      c = getc(db);
  445.                      }
  446.                il->u[1].s = str_install(&db_sbuf);
  447.                break;
  448.  
  449.             default:
  450.                db_err1(1, "expected call, const, cnv1, or cnv2");
  451.             }
  452.          break;
  453.  
  454.       case 'd':
  455.          if (getc(db) != 'e' || getc(db) != 'f')
  456.             db_err1(1, "expected def1 or def2");
  457.          switch (getc(db)) {
  458.             case '1':
  459.                il = new_il(IL_Def1, 3);
  460.                il->u[0].n = db_icntyp();      /* type code */
  461.                il->u[1].fld = db_ilvar();     /* source */
  462.                il->u[2].c_cd = db_ilc();      /* default value */
  463.                break;
  464.             case '2':
  465.                il = new_il(IL_Def2, 4);
  466.                il->u[0].n = db_icntyp();      /* type code */
  467.                il->u[1].fld = db_ilvar();     /* source */
  468.                il->u[2].c_cd = db_ilc();      /* default value */
  469.                il->u[3].c_cd = db_ilc();      /* destination */
  470.                break;
  471.             default:
  472.                db_err1(1, "expected dflt1 or dflt2");
  473.             }
  474.          break;
  475.  
  476.       case 'r':
  477.          if (getc(db) != 'u' || getc(db) != 'n' || getc(db) != 'e' ||
  478.             getc(db) != 'r' || getc(db) != 'r')
  479.             db_err1(1, "expected runerr1 or runerr2");
  480.          switch (getc(db)) {
  481.             case '1':
  482.                il = new_il(IL_Err1, 1);
  483.                c = getc(db);
  484.                SkipWhSp(c)
  485.                GetInt(n, c)
  486.                il->u[0].n = n;                   /* error number */
  487.                break;
  488.             case '2':
  489.                il = new_il(IL_Err2, 2);
  490.                c = getc(db);
  491.                SkipWhSp(c)
  492.                GetInt(n, c)
  493.                il->u[0].n = n;                  /* error number */
  494.                il->u[1].fld = db_ilvar();       /* variable */
  495.                break;
  496.             default:
  497.                db_err1(1, "expected runerr1 or runerr2");
  498.             }
  499.          break;
  500.  
  501.       case 'i':
  502.          switch (getc(db)) {
  503.             case 'f':
  504.                switch (getc(db)) {
  505.                   case '1':
  506.                      il = new_il(IL_If1, 2);
  507.                      il->u[0].fld = db_inlin();            /* condition */
  508.                      il->u[1].fld = db_inlin();            /* then clause */
  509.                      break;
  510.                   case '2':
  511.                      il = new_il(IL_If2, 3);
  512.                      il->u[0].fld = db_inlin();            /* condition */
  513.                      il->u[1].fld = db_inlin();            /* then clause */
  514.                      il->u[2].fld = db_inlin();            /* else clause */
  515.                      break;
  516.                   default:
  517.                      db_err1(1, "expected if1 or if2");
  518.                   }
  519.                break;
  520.             case 's':
  521.                il = new_il(IL_Is, 2);
  522.                il->u[0].n = db_icntyp();      /* type code */
  523.                il->u[1].fld = db_ilvar();     /* variable */
  524.                break;
  525.             default:
  526.                db_err1(1, "expected if1, if2, or is");
  527.             }
  528.          break;
  529.  
  530.       case 'l':
  531.          switch (getc(db)) {
  532.             case 'c':
  533.                db_chstr("lc", "ase");
  534.                c = getc(db);
  535.                SkipWhSp(c)
  536.                GetInt(n, c)                           /* number of cases */
  537.                il = new_il(IL_Lcase, 2 + 2 * n);
  538.                il->u[0].n = n;
  539.                indx = 1;
  540.                while (n--) {
  541.                   c = getc(db);
  542.                   SkipWhSp(c)
  543.                   GetInt(n1, c)
  544.                   il->u[indx++].n = n1;                /* selection number */
  545.                   il->u[indx++].fld = db_inlin();     /* action */
  546.                   }
  547.                il->u[indx].fld = db_inlin();          /* default */
  548.                break;
  549.  
  550.             case 's':
  551.                if (getc(db) != 't')
  552.                   db_err1(1, "expected lst");
  553.                il = new_il(IL_Lst, 2);
  554.                il->u[0].fld = db_inlin();
  555.                il->u[1].fld = db_inlin();
  556.                break;
  557.  
  558.             default:
  559.                db_err1(1, "expected lcase or lst");
  560.             }
  561.          break;
  562.  
  563.       case 'n':
  564.          db_chstr("n", "il");
  565.          il = NULL;
  566.          break;
  567.  
  568.       case 't': {
  569.          struct il_code *var;
  570.  
  571.          if (getc(db) != 'c' || getc(db) != 'a' || getc(db) != 's' ||
  572.             getc(db) != 'e')
  573.                db_err1(1, "expected tcase1 or tcase2");
  574.          switch (getc(db)) {
  575.             case '1':
  576.                var = db_ilvar();                         /* variable */
  577.                c = getc(db);
  578.                SkipWhSp(c)
  579.                GetInt(n, c)
  580.                il = new_il(IL_Tcase1, 3 * n + 2);
  581.                il->u[0].fld = var;
  582.                db_case(il, n);
  583.                break;
  584.  
  585.             case '2':
  586.                var = db_ilvar();                         /* variable */
  587.                c = getc(db);
  588.                SkipWhSp(c)
  589.                GetInt(n, c)
  590.                il = new_il(IL_Tcase2, 3 * n + 3);
  591.                il->u[0].fld = var;
  592.                db_case(il, n);
  593.                il->u[3 * n + 2].fld = db_inlin();    /* default */
  594.                break;
  595.  
  596.             default:
  597.                db_err1(1, "expected tcase1 or tcase2");
  598.             }
  599.          }
  600.          break;
  601.  
  602.       case '!':
  603.          il = new_il(IL_Bang, 1);
  604.          il->u[0].fld = db_inlin();
  605.          break;
  606.  
  607.       case '&':
  608.          if (getc(db) != '&')
  609.             db_err1(1, "expected &&");
  610.          il = new_il(IL_And, 2);
  611.          il->u[0].fld = db_inlin();
  612.          il->u[1].fld = db_inlin();
  613.          break;
  614.  
  615.       default:
  616.          db_err1(1, "syntax error");
  617.       }
  618.    return il;
  619.    }
  620.  
  621. static int db_rtflg()
  622.    {
  623.    register int c;
  624.    int ret_flag;
  625.  
  626.    ret_flag = 0;
  627.    c = getc(db);
  628.    SkipWhSp(c)
  629.    if (c == 'f')
  630.       ret_flag |= DoesFail;
  631.    else if (c != '_')
  632.      db_err1(1, "invalid return indicator");
  633.    c = getc(db);
  634.    if (c == 'r')
  635.       ret_flag |= DoesRet;
  636.    else if (c != '_')
  637.      db_err1(1, "invalid return indicator");
  638.    c = getc(db);
  639.    if (c == 's')
  640.       ret_flag |= DoesSusp;
  641.    else if (c != '_')
  642.      db_err1(1, "invalid return indicator");
  643.    c = getc(db);
  644.    if (c == 'e')
  645.       ret_flag |= DoesEFail;
  646.    else if (c != '_')
  647.      db_err1(1, "invalid return indicator");
  648.    c = getc(db);
  649.    if (c == 't')
  650.       ret_flag |= DoesFThru;
  651.    else if (c != '_' && c != ' ')
  652.      db_err1(1, "invalid return indicator");
  653.    return ret_flag;
  654.    }
  655.  
  656. static novalue db_case(il, num_cases)
  657. struct il_code *il;
  658. int num_cases;
  659.    {
  660.    register int c;
  661.    int *typ_vect;
  662.    int i, j;
  663.    int num_types;
  664.    int indx;
  665.  
  666.    il->u[1].n = num_cases;
  667.    indx = 2;
  668.    for (i = 0; i < num_cases; ++i) {
  669.       c = getc(db);
  670.       SkipWhSp(c)
  671.       GetInt(num_types, c)
  672.       il->u[indx++].n = num_types;
  673.       typ_vect = (int *)alloc((unsigned int)(sizeof(int) * num_types));
  674.       il->u[indx++].vect = typ_vect;
  675.       for (j = 0; j < num_types; ++j)
  676.          typ_vect[j] = db_icntyp();           /* type code */
  677.       il->u[indx++].fld = db_inlin();         /* action */
  678.       }
  679.    }
  680.  
  681. static struct il_code *db_ilvar()
  682.    {
  683.    struct il_code *il;
  684.    register int c;
  685.    int n;
  686.  
  687.    c = getc(db);
  688.    SkipWhSp(c)
  689.  
  690.    if (isdigit(c)) {
  691.       il = new_il(IL_Var, 1);
  692.       GetInt(n, c)
  693.       il->u[0].n = n;    /* symbol table index */
  694.       }
  695.    else {
  696.       if (c != '[')
  697.          db_err1(1, "expected symbol table index or '['");
  698.       il = new_il(IL_Subscr, 2);
  699.       c = getc(db);
  700.       SkipWhSp(c);
  701.       GetInt(n, c)
  702.       il->u[0].n = n;    /* symbol table index */
  703.       c = getc(db);
  704.       SkipWhSp(c)
  705.       GetInt(n, c)
  706.       il->u[1].n = n;    /* subscripting index */
  707.       }
  708.    return il;
  709.    }
  710.  
  711. static struct il_code *db_abstr()
  712.    {
  713.    struct il_code *il;
  714.    register int c;
  715.    word typcd;
  716.    word indx;
  717.    int nargs;
  718.  
  719.    c = getc(db);
  720.    SkipWhSp(c)
  721.    switch (c) {
  722.       case 'f':
  723.          db_chstr("f", "lds");
  724.          il = new_il(IL_Fields, 1);
  725.          il->u[0].fld = db_abstr();      /* record type */
  726.          break;
  727.  
  728.       case 'l':
  729.          if (getc(db) != 's' || getc(db) != 't')
  730.             db_err1(1, "expected lst or lstelm");
  731.          switch (getc(db)) {
  732.             case ' ':
  733.             case '\t':
  734.             case '\n':
  735.                il = new_il(IL_Lst, 2);
  736.                il->u[0].fld = db_abstr();
  737.                il->u[1].fld = db_abstr();
  738.                break;
  739.             case 'e':
  740.                db_chstr("lste", "lm");
  741.                il = new_il(IL_LstElm, 1);
  742.                il->u[0].fld = db_abstr();      /* list type */
  743.                break;
  744.             default:
  745.                db_err1(1, "expected lst or lstelm");
  746.             }
  747.          break;
  748.  
  749.       case 'n':
  750.          switch (getc(db)) {
  751.             case 'e':
  752.                if (getc(db) != 'w')
  753.                   db_err1(1, "expected new");
  754.                typcd = db_icntyp();
  755.                c = getc(db);
  756.                SkipWhSp(c)
  757.                GetInt(nargs, c)
  758.                il = new_il(IL_New, 2 + nargs); 
  759.                il->u[0].n = typcd;
  760.                il->u[1].n = nargs;
  761.                indx = 2;
  762.                while (nargs--)
  763.                   il->u[indx++].fld = db_abstr();
  764.                break;
  765.             case 'i':
  766.                if (getc(db) != 'l')
  767.                   db_err1(1, "expected nil");
  768.                il = NULL;
  769.                break;
  770.             default:
  771.                db_err1(1, "expected new or nil");
  772.             }
  773.        break;
  774.  
  775.       case 's':
  776.          switch (getc(db)) {
  777.             case 'e':
  778.                db_chstr("se", "telm");
  779.                il = new_il(IL_SetElm, 1);
  780.                il->u[0].fld = db_abstr();      /* set type */
  781.                break;
  782.             case 't':
  783.                switch (getc(db)) {
  784.                   case 'o':
  785.                      db_chstr("sto", "re");
  786.                      il = new_il(IL_Store, 1);
  787.                      il->u[0].fld = db_abstr();    /* type to "dereference" */
  788.                      break;
  789.                   case 'r':
  790.                      db_chstr("str", "var");
  791.                      il = new_il(IL_StrVar, 1);
  792.                      il->u[0].fld = db_abstr();    /* substring variable type */
  793.                      break;
  794.                   default:
  795.                      db_err1(1, "expected store or strvar");
  796.                   }
  797.                break;
  798.             default:
  799.                db_err1(1, "expected setelm, store, or strvar");
  800.             }
  801.          break;
  802.  
  803.       case 't':
  804.          switch (getc(db)) {
  805.             case 'b':
  806.                if (getc(db) != 'l')
  807.                   db_err1(1, "expected tbldf, tblelm, or tblkey");
  808.                switch (getc(db)) {
  809.                    case 'd':
  810.                      db_chstr("tbld", "ft");
  811.                      il = new_il(IL_TblDft, 1);
  812.                      il->u[0].fld = db_abstr();      /* table type */
  813.                      break;
  814.                    case 'e':
  815.                      db_chstr("tble", "lm");
  816.                      il = new_il(IL_TblElm, 1);
  817.                      il->u[0].fld = db_abstr();      /* table type */
  818.                      break;
  819.                    case 'k':
  820.                      db_chstr("tblk", "ey");
  821.                      il = new_il(IL_TblKey, 1);
  822.                      il->u[0].fld = db_abstr();      /* table type */
  823.                      break;
  824.                   default:
  825.                      db_err1(1, "expected tbldf, tblelm, or tblkey");
  826.                   }
  827.                break;
  828.             case 'r':
  829.                db_chstr("tr", "ptbl");
  830.                il = new_il(IL_TrpTbl, 1);
  831.                il->u[0].fld = db_abstr();      /* table trapped variable type */
  832.                break;
  833.             case 'y':
  834.                if (getc(db) != 'p')
  835.                   db_err1(1, "expected typ"); 
  836.                il = new_il(IL_IcnTyp, 1);
  837.                il->u[0].n = db_icntyp();      /* type code */
  838.                break;
  839.             default:
  840.                db_err1(1, "expected tbldft, tblelm, tblkey, or typ");
  841.             }
  842.          break;
  843.  
  844.       case 'v':
  845.          db_chstr("v", "artyp");
  846.          il = new_il(IL_VarTyp, 1);
  847.          il->u[0].fld = db_ilvar();     /* variable */
  848.          break;
  849.       
  850.       case '=':
  851.          il = new_il(IL_TpAsgn, 2);
  852.          il->u[0].fld = db_abstr();
  853.          il->u[1].fld = db_abstr();
  854.          break;
  855.  
  856.       case '+':
  857.          if (getc(db) != '+')
  858.             db_err1(1, "expected ++");
  859.          il = new_il(IL_Union, 2);
  860.          il->u[0].fld = db_abstr();
  861.          il->u[1].fld = db_abstr();
  862.          break;
  863.  
  864.       case '*':
  865.          if (getc(db) != '*')
  866.             db_err1(1, "expected **"); 
  867.          il = new_il(IL_Inter, 2);
  868.          il->u[0].fld = db_abstr();
  869.          il->u[1].fld = db_abstr();
  870.          break;
  871.       }
  872.    return il;
  873.    }
  874.  
  875. /*
  876.  * db_ilc - read a piece of in-line C code.
  877.  */
  878. static struct il_c *db_ilc()
  879.    {
  880.    register int c;
  881.    int old_c;
  882.    word n;
  883.    struct il_c *base = NULL;
  884.    struct il_c **nxtp = &base;
  885.  
  886.    c = getc(db);
  887.    SkipWhSp(c)
  888.    switch (c) {
  889.       case '$':
  890.          /*
  891.           * This had better be the starting $c.
  892.           */
  893.          c = getc(db);
  894.          if (c == 'c') {
  895.             c = getc(db);
  896.             for (;;) {
  897.                SkipWhSp(c)
  898.                if (c == '$') {
  899.                   c = getc(db);
  900.                   switch (c) {
  901.                      case 'c':             /* $cb or $cgoto <cond> <lbl num> */
  902.                         c = getc(db);
  903.                         switch (c) {
  904.                            case 'b':
  905.                               *nxtp = new_ilc(ILC_CBuf);
  906.                               c = getc(db);
  907.                               break;
  908.                            case 'g':
  909.                               db_chstr("$cg", "oto");
  910.                               *nxtp = new_ilc(ILC_CGto);
  911.                               (*nxtp)->code[0] = db_ilc();
  912.                               c = getc(db);
  913.                               SkipWhSp(c);
  914.                               if (!isdigit(c))
  915.                                  db_err1(1, "$cgoto: expected label number");
  916.                               GetInt(n, c);
  917.                               (*nxtp)->n = n;
  918.                               break;
  919.                            default:
  920.                              db_err1(1, "expected $cb or $cgoto");
  921.                            }
  922.                         break;
  923.                      case 'e':
  924.                         c = getc(db);
  925.                         if (c == 'f') {             /* $efail */
  926.                             db_chstr("$ef", "ail");
  927.                             *nxtp = new_ilc(ILC_EFail);
  928.                             c = getc(db);
  929.                             break;
  930.                             }
  931.                         else 
  932.                            return base;            /* $e */
  933.                      case 'f':                     /* $fail */
  934.                         db_chstr("$f", "ail");
  935.                         *nxtp = new_ilc(ILC_Fail);
  936.                         c = getc(db);
  937.                         break;
  938.                      case 'g':                     /* $goto <lbl num> */
  939.                         db_chstr("$g", "oto");
  940.                         *nxtp = new_ilc(ILC_Goto);
  941.                         c = getc(db);
  942.                         SkipWhSp(c);
  943.                         if (!isdigit(c))
  944.                            db_err1(1, "$goto: expected label number");
  945.                         GetInt(n, c);
  946.                         (*nxtp)->n = n;
  947.                         break;
  948.                      case 'l':                     /* $lbl <lbl num> */
  949.                         db_chstr("$l", "bl");
  950.                         *nxtp = new_ilc(ILC_Lbl);
  951.                         c = getc(db);
  952.                         SkipWhSp(c);
  953.                         if (!isdigit(c))
  954.                            db_err1(1, "$lbl: expected label number");
  955.                         GetInt(n, c);
  956.                         (*nxtp)->n = n;
  957.                         break;
  958.                      case 'm':                     /* $m[d]<indx> */
  959.                         *nxtp = new_ilc(ILC_Mod);
  960.                         c = getc(db);
  961.                         if (c == 'd') {
  962.                            (*nxtp)->s = "d";
  963.                            c = getc(db);
  964.                            }
  965.                         if (isdigit(c)) {
  966.                            GetInt(n, c);
  967.                            (*nxtp)->n = n;
  968.                            }
  969.                         else if (c == 'r') {
  970.                            (*nxtp)->n = RsltIndx;
  971.                            c = getc(db);
  972.                            }
  973.                         else
  974.                            db_err1(1, "$m: expected symbol table index");
  975.                         break;
  976.                      case 'r':                     /* $r[d]<indx> or $ret ... */
  977.                         c = getc(db);
  978.                         if (isdigit(c) || c == 'd') {
  979.                            *nxtp = new_ilc(ILC_Ref);
  980.                            if (c == 'd') {
  981.                               (*nxtp)->s = "d";
  982.                               c = getc(db);
  983.                               }
  984.                            GetInt(n, c);
  985.                            (*nxtp)->n = n;
  986.                            }
  987.                         else if (c == 'r') {
  988.                            *nxtp = new_ilc(ILC_Ref);
  989.                            (*nxtp)->n = RsltIndx;
  990.                            c = getc(db);
  991.                            }
  992.                         else {
  993.                            if (c != 'e' || getc(db) != 't')
  994.                               db_err1(1, "expected $ret");
  995.                            *nxtp = db_ilcret(ILC_Ret);
  996.                            c = getc(db);
  997.                            }
  998.                         break;
  999.                      case 's':                     /* $sb or $susp ... */
  1000.                         c = getc(db);
  1001.                         switch (c) {
  1002.                            case 'b':
  1003.                               *nxtp = new_ilc(ILC_SBuf);
  1004.                               c = getc(db);
  1005.                               break;
  1006.                            case 'u':
  1007.                               db_chstr("$su", "sp");
  1008.                               *nxtp = db_ilcret(ILC_Susp);
  1009.                               c = getc(db);
  1010.                               break;
  1011.                            default:
  1012.                              db_err1(1, "expected $sb or $susp");
  1013.                            }
  1014.                         break;
  1015.                      case 't':                     /* $t[d]<indx> */
  1016.                         *nxtp = new_ilc(ILC_Tend);
  1017.                         c = getc(db);
  1018.                         if (!isdigit(c))
  1019.                            db_err1(1, "$t: expected index");
  1020.                         GetInt(n, c);
  1021.                         (*nxtp)->n = n;
  1022.                         break;
  1023.                      case '{':
  1024.                         *nxtp = new_ilc(ILC_LBrc);
  1025.                         c = getc(db);
  1026.                         break;
  1027.                      case '}':
  1028.                         *nxtp = new_ilc(ILC_RBrc);
  1029.                         c = getc(db);
  1030.                         break;
  1031.                      default:
  1032.                         db_err1(1, "invalid $ escape in C code");
  1033.                      }
  1034.                   }
  1035.                else {
  1036.                   /*
  1037.                    * Arbitrary code - gather into a string.
  1038.                    */
  1039.                   while (c != '$' && c != EOF) {
  1040.                      if (c == '"' || c == '\'') {
  1041.                         quoted(c);
  1042.                         c = getc(db);
  1043.                         }
  1044.                      old_c = c;
  1045.                      AppChar(db_sbuf, c);
  1046.                      c = getc(db);
  1047.                      if (old_c == ' ')
  1048.                         while (c == ' ')
  1049.                            c = getc(db);
  1050.                      }
  1051.                   *nxtp = new_ilc(ILC_Str);
  1052.                   (*nxtp)->s = str_install(&db_sbuf);
  1053.                   }
  1054.                nxtp = &(*nxtp)->next;
  1055.                }
  1056.             }
  1057.          break;
  1058.       case 'n':
  1059.          db_chstr("n", "il");
  1060.          return NULL;
  1061.       }
  1062.    db_err1(1, "expected C code of the form $c ... $e or nil");
  1063.    }
  1064.  
  1065. static novalue quoted(delim)
  1066. int delim;
  1067.    {
  1068.    register int c;
  1069.  
  1070.    AppChar(db_sbuf, delim);
  1071.    c = getc(db);
  1072.    while (c != delim && c != EOF) {
  1073.       if (c == '\\') {
  1074.          AppChar(db_sbuf, c);
  1075.          c = getc(db);
  1076.          if (c == EOF)
  1077.             db_err1(1, "unexpected EOF in quoted literal");
  1078.          }
  1079.       AppChar(db_sbuf, c);
  1080.       c = getc(db);
  1081.       }
  1082.    if (c == EOF)
  1083.       db_err1(1, "unexpected EOF in quoted literal");
  1084.    AppChar(db_sbuf, c);
  1085.    }
  1086.  
  1087. static struct il_c *db_ilcret(il_c_type)
  1088. int il_c_type;
  1089.    {
  1090.    struct il_c *ilc;
  1091.    int c;
  1092.    int n;
  1093.    int i;
  1094.  
  1095.    ilc = new_ilc(il_c_type);
  1096.    ilc->n = db_icntyp();
  1097.    c = getc(db);
  1098.    SkipWhSp(c)
  1099.    GetInt(n, c)
  1100.    for (i = 0; i < n; ++i)
  1101.       ilc->code[i] = db_ilc();
  1102.    return ilc;
  1103.    } 
  1104.  
  1105. static int db_tndtyp()
  1106.    {
  1107.    int c;
  1108.  
  1109.    c = getc(db);
  1110.    SkipWhSp(c)
  1111.    switch (c) {
  1112.        case 'b':
  1113.           db_chstr("b", "lkptr");
  1114.           return TndBlk;
  1115.        case 'd':
  1116.           db_chstr("d", "esc");
  1117.           return TndDesc;
  1118.        case 's':
  1119.           db_chstr("s", "tr");
  1120.           return TndStr;
  1121.       default:
  1122.           db_err1(1, "expected blkptr, desc, or str");
  1123.           /* NOTREACHED */
  1124.       }
  1125.    }
  1126.  
  1127. static int db_icntyp()
  1128.    {
  1129.    int c;
  1130.  
  1131.    c = getc(db);
  1132.    SkipWhSp(c)
  1133.    switch (c) {
  1134.       case 'c':
  1135.          switch (getc(db)) {
  1136.             case 'i':
  1137.                return TypCInt;
  1138.             case 'd': 
  1139.                return TypCDbl;
  1140.             case 's':
  1141.                return TypCStr;
  1142.             case ' ':
  1143.             case '\n':
  1144.             case '\t':
  1145.                return TypCset;
  1146.             }
  1147.          break;
  1148.       case 'd':
  1149.          return RetDesc;
  1150.       case 'e':
  1151.          switch (getc(db)) {
  1152.             case 'c':
  1153.                if (getc(db) == 'i')
  1154.                   return TypECInt;
  1155.                break;
  1156.             case 'i':
  1157.                return TypEInt;
  1158.             case ' ':
  1159.             case '\n':
  1160.             case '\t':
  1161.                 return TypEmpty;
  1162.             }
  1163.          break;
  1164.       case 'f':
  1165.          return TypFile;
  1166.       case 'i':
  1167.          return TypInt;
  1168.       case 'k':
  1169.          switch (getc(db)) {
  1170.             case 'i':
  1171.                return TypKyInt;
  1172.             case 's':
  1173.                return TypKySub;
  1174.             case 'p':
  1175.                return TypKyPos;
  1176.             }
  1177.          break;
  1178.       case 'n':
  1179.          switch (getc(db)) {
  1180.             case 'v':
  1181.                return RetNVar;
  1182.             case ' ':
  1183.             case '\n':
  1184.             case '\t':
  1185.                return TypNull;
  1186.             }
  1187.          break;
  1188.       case 'p':
  1189.             return TypProc;
  1190.       case 'r':
  1191.          switch (getc(db)) {
  1192.             case 'n':
  1193.                return RetNone;
  1194.             case ' ':
  1195.             case '\n':
  1196.             case '\t':
  1197.                return TypReal;
  1198.             }
  1199.          break;
  1200.       case 's':
  1201.          switch (getc(db)) {
  1202.             case 's':
  1203.                return TypTvStr;
  1204.             case 'v':
  1205.                return RetSVar;
  1206.             case ' ':
  1207.             case '\n':
  1208.             case '\t':
  1209.                return TypStr;
  1210.             }
  1211.          break;
  1212.       case 't':
  1213.          switch (getc(db)) {
  1214.             case 'c':
  1215.                return TypTCset;
  1216.             case 's':
  1217.                return TypTStr;
  1218.             case 't':
  1219.                return TypTvTbl;
  1220.             }
  1221.          break;
  1222.       case 'v':
  1223.          return TypVar;
  1224.       case 'C':
  1225.          return TypCoExp;
  1226.       case 'L':
  1227.          return TypList;
  1228.       case 'R':
  1229.          return TypRec;
  1230.       case 'S':
  1231.          return TypSet;
  1232.       case 'T':
  1233.          return TypTbl;
  1234.       }
  1235.    db_err1(1, "invalid type code");
  1236.    /* NOTREACHED */
  1237.    }
  1238.  
  1239. static struct il_c *new_ilc(il_c_type)
  1240. int il_c_type;
  1241.    {
  1242.    struct il_c *ilc;
  1243.    int i;
  1244.  
  1245.    ilc = NewStruct(il_c);
  1246.    ilc->next = NULL;
  1247.    ilc->il_c_type = il_c_type;
  1248.    for (i = 0; i < 3; ++i)
  1249.       ilc->code[i] = NULL;
  1250.    ilc->n = 0;
  1251.    ilc->s = NULL;
  1252.    return ilc;
  1253.    }
  1254.  
  1255. struct il_code *new_il(il_type, size)
  1256. int il_type;
  1257. int size;
  1258.    {
  1259.    struct il_code *il;
  1260.  
  1261.    il = (struct il_code *)alloc((unsigned int)
  1262.       (sizeof(struct il_code) + (size-1) * sizeof(union il_fld)));
  1263.    il->il_type = il_type;
  1264.    return il;
  1265.    }
  1266.  
  1267. /*
  1268.  * db_dscrd - discard an implementation, skipping the in-line code.
  1269.  */
  1270. novalue db_dscrd(ip)
  1271. struct implement *ip;
  1272.    {
  1273.    char state;  /* how far along we are at recognizing $end */
  1274.  
  1275.    free(ip);
  1276.    state = '\0';
  1277.    for (;;) {
  1278.       switch (getc(db)) {
  1279.          case '$':
  1280.             state = '$';
  1281.             continue;
  1282.          case 'e':
  1283.             if (state == '$') {
  1284.                state = 'e';
  1285.                continue;
  1286.                }
  1287.             break;
  1288.          case 'n':
  1289.             if (state == 'e') {
  1290.                state = 'n';
  1291.                continue;
  1292.                }
  1293.             break;
  1294.          case 'd':
  1295.             if (state == 'n')
  1296.                return;
  1297.             break;
  1298.          case '\n':
  1299.             ++dbline;
  1300.             break;
  1301.          case EOF:
  1302.             db_err1(1, "unexpected EOF");
  1303.          }
  1304.       state = '\0';
  1305.       }
  1306.    }
  1307.  
  1308. /*
  1309.  * db_chstr - we are expecting a specific string. We may already have
  1310.  *   read a prefix of it.
  1311.  */
  1312. novalue db_chstr(prefix, suffix)
  1313. char *prefix;
  1314. char *suffix;
  1315.    {
  1316.    int c;
  1317.  
  1318.    c = getc(db);
  1319.    SkipWhSp(c)
  1320.  
  1321.    for (;;) {
  1322.       if (*suffix == '\0' && (isspace(c) || c == EOF)) {
  1323.          if (c == '\n')
  1324.             ++dbline;
  1325.          return;
  1326.          }
  1327.       else if (*suffix != c)
  1328.          break;
  1329.       c = getc(db);
  1330.       ++suffix;
  1331.       }
  1332.    db_err3(1, "expected:", prefix, suffix);
  1333.    }
  1334.  
  1335. /*
  1336.  * db_tbl - fill in a table of implementation information for the given section.
  1337.  */
  1338. int db_tbl(section, tbl)
  1339. char *section;
  1340. struct implement **tbl;
  1341.    {
  1342.    struct implement *ip;
  1343.    int num_added = 0;
  1344.    unsigned hashval;
  1345.  
  1346.    /*
  1347.     * Get past the section header.
  1348.     */
  1349.    db_chstr("", section);
  1350.  
  1351.    while ((ip = db_impl(toupper(section[0]))) != NULL) {
  1352.       if (db_ilkup(ip->name, tbl) == NULL) {
  1353.          db_code(ip);
  1354.          hashval = IHasher(ip->name);
  1355.          ip->blink = tbl[hashval];
  1356.          tbl[hashval] = ip;
  1357.          ++num_added;
  1358.          db_chstr("", "end");
  1359.          }
  1360.       else
  1361.          db_dscrd(ip);
  1362.       }
  1363.    db_chstr("", "endsect");
  1364.    return num_added;
  1365.    }
  1366.  
  1367. /*
  1368.  * db_ilkup looks up id in a table of implementation information and returns
  1369.  *  pointer it or NULL if it is not there.
  1370.  */
  1371. struct implement *db_ilkup(id, tbl)
  1372. char *id;
  1373. struct implement **tbl;
  1374.    {
  1375.    register struct implement *ptr;
  1376.  
  1377.    ptr = tbl[IHasher(id)];
  1378.    while (ptr != NULL && ptr->name != id)
  1379.       ptr = ptr->blink;
  1380.    return ptr;
  1381.    }
  1382.  
  1383. /*
  1384.  * nxt_pre - assign next prefix. A prefix is 2 characters from 0-9 and a-z,
  1385.  *   at least one of which is numeric.
  1386.  *
  1387.  * Warning - ascii dependence, must be changed for ebcdic.
  1388.  *
  1389.  */
  1390. novalue nxt_pre(pre, nxt)
  1391. char *pre;
  1392. char *nxt;
  1393.    {
  1394.    if (nxt[0] == 'z' + 1) {
  1395.       fprintf(stderr, "out of unique prefixes\n");
  1396.       exit(ErrorExit);
  1397.       }
  1398.  
  1399.    pre[0] = nxt[0];
  1400.    pre[1] = nxt[1];
  1401.  
  1402.    /*
  1403.     * increment next nxtfix.
  1404.     */
  1405.    if (nxt[1] == '9') {
  1406.       if (isdigit(nxt[0]))
  1407.          nxt[1] = 'a';
  1408.       else {
  1409.          if (nxt[0] == '9')
  1410.             nxt[0] = 'a';
  1411.          else
  1412.             ++nxt[0];
  1413.          nxt[1] = '0';
  1414.          }
  1415.       }
  1416.    else if (nxt[1] == 'z') {
  1417.       if (nxt[0] == '9')
  1418.          nxt[0] = 'a';
  1419.       else
  1420.          ++nxt[0];
  1421.       nxt[1] = '0';
  1422.       }
  1423.    else
  1424.       ++nxt[1];
  1425.    }
  1426.  
  1427. int cmp_pre(pre1, pre2)
  1428. char *pre1;
  1429. char *pre2;
  1430.    {
  1431.    int cmp;
  1432.  
  1433.    cmp = cmp_1_pre(pre1[0], pre2[0]);
  1434.    if (cmp == 0)
  1435.       return cmp_1_pre(pre1[1], pre2[1]);
  1436.    else
  1437.       return cmp;
  1438.    }
  1439.  
  1440. static int cmp_1_pre(p1, p2)
  1441. int p1;
  1442. int p2;
  1443.    {
  1444.    if (isdigit(p1)) {
  1445.       if (isdigit(p2))
  1446.          return p1 - p2;
  1447.       else
  1448.          return -1;
  1449.       }
  1450.     else {
  1451.        if (isdigit(p2))
  1452.           return 1;
  1453.        else
  1454.          return p1 - p2;
  1455.       }
  1456.    }
  1457.  
  1458. novalue db_err1(fatal, s)
  1459. int fatal;
  1460. char *s;
  1461.    {
  1462.    if (fatal)
  1463.       fprintf(stderr, "error, ");
  1464.    else
  1465.       fprintf(stderr, "warning, ");
  1466.    fprintf(stderr, "data base \"%s\", line %d - %s\n", dbname, dbline, s);
  1467.    if (fatal)
  1468.       exit(ErrorExit);
  1469.    }
  1470.  
  1471. novalue db_err2(fatal, s1, s2)
  1472. int fatal;
  1473. char *s1;
  1474. char *s2;
  1475.    {
  1476.    if (fatal)
  1477.       fprintf(stderr, "error, ");
  1478.    else
  1479.       fprintf(stderr, "warning, ");
  1480.    fprintf(stderr, "data base \"%s\", line %d - %s %s\n", dbname, dbline, s1,
  1481.       s2);
  1482.    if (fatal)
  1483.       exit(ErrorExit);
  1484.    }
  1485.  
  1486. static novalue db_err3(fatal, s1, s2, s3)
  1487. int fatal;
  1488. char *s1;
  1489. char *s2;
  1490. char *s3;
  1491.    {
  1492.    if (fatal)
  1493.       fprintf(stderr, "error, ");
  1494.    else
  1495.       fprintf(stderr, "warning, ");
  1496.    fprintf(stderr, "data base \"%s\", line %d - %s %s%s\n", dbname, dbline, s1,
  1497.       s2, s3);
  1498.    if (fatal)
  1499.       exit(ErrorExit);
  1500.    }
  1501.